(DE ORDEREQUAL2(L)
(PROG(Z)(COND ((NEG L)(SETQ Z(CDR L)))(T(SETQ Z L)))
(COND((EQ(CAR Z)EQUAL)(ORDEREQUAL(CDR Z))))
(RETURN L) ))

(DEFPROP UNION 
 (LAMBDA(Z C D YC YD)
  (PROG (BL L Z1 Z2 Z3 Z4 Z5 Z6 C1 C2 NEG RES M1 Z7 Z8)
(COND(PARRES(ORDEREQUAL2 PARRES)))
	(SETQ NO* NO)
	(COND
	 (ORDER (COND (ANCESTRY (SETQ SAT C) (SETQ L YC)) ((EQ C SAT) (SETQ L YC)) (T (SETQ L YD)))
		(COND ((< L (CDR SAT)) (RETURN NIL)))))
	(SETQ M1 0)
	(SETQ Z7 (ANCESTOR C))
	(SETQ Z8 (ANCESTOR D))
	(SETQ C (CDR C))
	(SETQ D (CDR D))
	(SETQ Z1 Z)
	(SETQ Z2 Z)
	(SETQ Z3 (ORDEREQUAL2(SUBS3T** Z1 YC)))
	(SETQ Z4 (ORDEREQUAL2(SUBS3T** Z2 YD)))
   UN1  (SETQ Z5 (ORDEREQUAL2(SUBS3T** Z1 (CAR C))))
	(COND ((OR (EQUAL Z3 Z5) (MEMC Z5 C1)) (SETQ M1 (ADD1 M1)) (GO UN1A))
	      ((AND (NEG Z5) (MEMC (CDR Z5) C1)) (RETURN NIL)))
	(SETQ C1 (CONS Z5 C1))
   UN1A (SETQ C (CDR C))
	(COND (C (GO UN1)))
   UN2  (SETQ Z6 (ORDEREQUAL2(SUBS3T** Z2 (CAR D))))
	(COND ((AND PARRES (EQUAL Z4 Z6)) (SETQ Z6 PARRES) )
	      ((OR (EQUAL Z4 Z6) (MEMC Z6 C2)) (SETQ M1 (ADD1 M1)) (GO UN2A)))
	(COND ((NEG Z6) (COND ((OR (MEMC (CDR Z6) C1) (MEMC (CDR Z6) C2)) (RETURN NIL))))
	      ((POS Z6) (COND ((MEMBER (CONS ESCAPE Z6) C1) (RETURN NIL)))))
   UN2B (SETQ C2 (CONS Z6 C2))
   UN2A (SETQ D (CDR D))
	(COND (D (GO UN2)))
	(SETQ Z2 0)
	(COND ((NULL C1) (COND ((NULL C2) (RETURN (LIST NIL))) (T (SETQ Z1 C2) (GO UN7))))
	      ((NULL C2) (SETQ Z1 C1) (GO UN7)))
	(COND ((AND MERGE (EQ M1 2) (CDR Z7) (CDR Z8)) (RETURN NIL)))
   UN5  (SETQ NEG RES)
	(COND ((NULL C1) (SETQ Z1 C2) (GO UN7))
	      ((NULL C2) (SETQ Z1 C1) (GO UN7))
	      ((AND (POS (CAR C1)) (POS (CAR C2))) (GO UN3))
	      ((AND (POS (CAR C1)) (NEG (CAR C2))) (GO UN6))
	      ((OR (AND (NEG (CAR C1)) (POS (CAR C2))) (NOT (ORDERP (CADAR C1) (CADAR C2))))
	       (SETQ Z1 (CAR C1))
	       (SETQ C1 (CDR C1))
	       (GO UN4)))
   UN6  (SETQ Z1 (CAR C2))
	(SETQ C2 (CDR C2))
   UN4  (UPIT Z1)
	(COND ((MEMBER Z1 RES) (GO UN5)) (T (SETQ Z2 (ADD1 Z2)) (SETQ RES (CONS Z1 RES)) (GO UN5)))
   UN7  (COND ((NULL Z1) (RETURN (LIST (CONS (LIST Z2 NEG) RES)))) ((MEMBER (CAR Z1) RES) (GO UN8)))
	(SETQ Z2 (ADD1 Z2))
	(UPIT (CAR Z1))
	(SETQ RES (CONS (CAR Z1) RES))
	(COND ((NEG (CAR Z1)) (SETQ NEG RES)))
   UN8  (SETQ Z1 (CDR Z1))
	(GO UN7)
   UN3  (COND ((NOT (ORDERP (CAAR C1) (CAAR C2))) (SETQ Z1 (CAR C1)) (SETQ C1 (CDR C1)) (GO UN4A)))
	(SETQ Z1 (CAR C2))
	(SETQ C2 (CDR C2))
   UN4A (UPIT1 (CDR Z1))
	(COND ((MEMBER Z1 RES) (GO UN5A)))
	(SETQ Z2 (ADD1 Z2))
	(SETQ RES (CONS Z1 RES))
   UN5A (COND ((NULL C1) (SETQ Z1 C2) (GO UN7)) ((NULL C2) (SETQ Z1 C1) (GO UN7)))
	(GO UN3))) 
EXPR)